home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / dial.tcl < prev    next >
Text File  |  1996-08-15  |  5KB  |  187 lines
  1. # (nowrap)
  2. set menuFlags(defaultFont)        "system monaco courier geneva helvetica times {new york}"
  3. set menuFlags(printerFont)        "system monaco courier geneva helvetica times {new york}"
  4. set menuFlags(printerFontSize)    "9 10 12 14 18"
  5. set menuFlags(fontSize)            "9 10 12 14 18"
  6. set menuFlags(savedState)        "none think mpw"
  7.  
  8.             
  9. proc suffixMappings {} {
  10.     global filepats
  11.     
  12.     set l1 5
  13.     set w1 35
  14.     set l2 [expr $l1 + $w1 + 5]
  15.     set w2 200
  16.     set h 18
  17.     set top 5
  18.     set mar 5
  19.  
  20.     set modes [lsort -ignore [array names filepats]]
  21.     set len [expr [llength $modes] + 1]
  22.     set modes1 [lrange $modes 0 [expr $len/2 - 1]]
  23.     set modes2 [lrange $modes [expr $len/2] end]
  24.     
  25.     foreach m $modes1 {
  26.         lappend items -t $m $l1 $top [expr $l1 + $w1] [expr $top + $h]
  27.         lappend items -e $filepats($m) $l2 $top [expr $l2 + $w2] [expr $top + $h - 2]
  28.         incr top [expr $h + $mar]
  29.     }
  30.  
  31.     set top2 5
  32.     set l1 [expr $l2 + $w2 + 20]
  33.     set l2 [expr $l1 + $w1 + 5]
  34.     foreach m $modes2 {
  35.         lappend items -t $m $l1 $top2 [expr $l1 + $w1] [expr $top2 + $h]
  36.         lappend items -e $filepats($m) $l2 $top2 [expr $l2 + $w2] [expr $top2 + $h - 2]
  37.         incr top2 [expr $h + $mar]
  38.     }
  39.     
  40.     if {$top2 > $top} {
  41.         set top $top2
  42.     }
  43.     incr top $mar
  44.     
  45.     set l1 5
  46.     lappend buts -b OK $l1 $top [expr $l1 + 60] [expr $top + 20]
  47.     lappend buts -b Cancel [expr $l1 + 100] $top [expr $l1 + 160] [expr $top + 20]
  48.     
  49.     set res [eval "dialog -w [expr $l2 + $w2 + 10] -h [expr $top + 27]" $buts $items]
  50.     
  51.     if {[car $res]} {
  52.         set res [cddr $res]
  53.  
  54.         foreach m [lsort -ignore [array names filepats]] {
  55.             if {$filepats($m) != [car $res]} {
  56.                 lappend changed [list $m [car $res]]
  57.             }
  58.             set res [cdr $res]
  59.         }
  60.  
  61.         foreach pair $changed {
  62.             addArrDef filepats [car $pair] [cadr $pair]
  63.         }
  64.     }
  65. }
  66. bind f12 suffixDialog
  67.  
  68.  
  69. proc modeDialog {flags vars} {
  70.     global menuFlags
  71.     
  72.     set left 20
  73.     set top 10
  74.     set t $top
  75.     
  76.     set perRow    3
  77.     set width    150
  78.     set height    15
  79.  
  80.     set ind 0 
  81.  
  82.     foreach f $flags {
  83.         global $f
  84.         set l [expr $left + ($ind % $perRow) * $width]
  85.         set t [expr $top + ($ind / $perRow) * $height]
  86.         lappend args "-c" $f [set $f] $l $t [expr $l + $width] [expr $t + $height]
  87.         incr ind
  88.     }
  89.     
  90.     if {$ind} {
  91.         set top [expr $t + 40]
  92.         set divider "-p 100 [expr $t + 27] 300 [expr $t + 28]"
  93.     } else {
  94.         set divider ""
  95.         
  96.     }
  97.     
  98.     set perRow    1
  99.     set width    400
  100.     set height    15
  101.     
  102.     set inc [expr $height + 10]
  103.     
  104.     set ind 0
  105.     foreach v $vars {
  106.         global $v
  107.         set l [expr $left + ($ind % $perRow) * $width]
  108.         set t [expr $top + ($ind / $perRow) * $inc]
  109.         lappend args "-t" "$v:" $l $t [expr $l + 135] [expr $t + $height]
  110.  
  111.         if {[string match "*Color" $v]} {
  112.             lappend args "-m" [concat [list [set $v]] {none blue cyan green magenta red white yellow}] [expr $l + 133] $t [expr $l + $width - 14] [expr $t + $height +1]
  113.         } elseif {[info exists menuFlags($v)]} {
  114.             lappend args "-m" [concat [list [set $v]] $menuFlags($v)] [expr $l + 133] $t [expr $l + $width - 14] [expr $t + $height +1]
  115.         } else {
  116.             lappend args "-e" [set $v] [expr $l + 135] $t [expr $l + $width - 10] [expr $t + $height +1]
  117.         }
  118.         incr ind
  119.     }
  120.     
  121.     set height [expr $t + 60]
  122.     set res [eval dialog -w 480 -h $height -b OK $left [expr $height-30] [expr $left + 60] [expr $height-10] $divider -b Cancel [expr $left + 100] [expr $height-30] [expr $left + 160] [expr $height-10] $args] 
  123.     if {[lindex $res 0]} {
  124.         return [lrange $res 2 end]
  125.     } else {
  126.         error "Cancel chosen"
  127.     }
  128. }
  129.  
  130.  
  131.  
  132. proc dialSet {flags vars} {
  133.     global maxT menuFlags
  134.     
  135.     set left 20
  136.     set top 40
  137.     set t $top
  138.     
  139.     set perRow    3
  140.     set width    150
  141.     set height    15
  142.  
  143.     set ind 0 
  144.  
  145.     set args {}
  146.     
  147.     foreach f $flags {
  148.         global $f
  149.         set l [expr $left + ($ind % $perRow) * $width]
  150.         set t [expr $top + ($ind / $perRow) * $height]
  151.         lappend args "-c" $f [set $f] $l $t [expr $l + $width] [expr $t + $height]
  152.         incr ind
  153.     }
  154.     
  155.     if {$ind} {
  156.         set top [expr $t + 40]
  157.         lappend args -p 100 [expr $t + 27] 300 [expr $t + 28]
  158.     }
  159.     
  160.     set perRow    1
  161.     set width    400
  162.     set height    17
  163.     
  164.     set inc [expr $height + 10]
  165.     
  166.     set ind 0 
  167.     foreach v $vars {
  168.         global $v
  169.         set l [expr $left + ($ind % $perRow) * $width]
  170.         set t [expr $top + ($ind / $perRow) * $inc]
  171.         lappend args "-t" "$v:" $l $t [expr $l + 135] [expr $t + $height]
  172.  
  173.         if {[string match "*Color" $v]} {
  174.             lappend args "-m" [concat [list [set $v]] {none blue cyan green magenta red white yellow}] [expr $l + 133] $t [expr $l + $width - 14] [expr $t + $height +1]
  175.         } elseif {[info exists menuFlags($v)]} {
  176.             lappend args "-m" [concat [list [set $v]] $menuFlags($v)] [expr $l + 133] $t [expr $l + $width - 14] [expr $t + $height +1]
  177.         } else {
  178.             lappend args "-e" [set $v] [expr $l + 135] $t [expr $l + $width - 12] [expr $t + $height +1]
  179.         }
  180.         incr ind
  181.     }
  182.  
  183.     incr t 30
  184.     if {$t > $maxT} {set maxT $t}
  185.     return $args
  186. }
  187.